The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
Changes 03
META.yml 11
lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm 515
lib/MooseX/Role/Parameterized.pm 11
t/002-role-block.t 1547
5 files changed (This is a version diff) 2267
@@ -1,5 +1,8 @@
 Changes for MooseX-Role-Parameterized
 
+0.21  November 15, 2010
+    * "package" arg can now tell generate_role to use a specific package (rjbs)
+
 0.20  November 2, 2010
     * Minor test refactoring to fix blead support [rt.perl.org #78244]
 
@@ -27,4 +27,4 @@ resources:
   homepage: http://github.com/sartak/MooseX-Role-Parameterized/tree
   license: http://dev.perl.org/licenses/
   repository: git://github.com/sartak/MooseX-Role-Parameterized.git
-version: 0.20
+version: 0.21
@@ -82,10 +82,19 @@ sub generate_role {
     my $parameterized_role_metaclass = $self->parameterized_role_metaclass;
     Class::MOP::load_class($parameterized_role_metaclass);
 
-    my $role = $parameterized_role_metaclass->create_anon_role(
-        genitor    => $self,
-        parameters => $parameters,
-    );
+    my $role;
+    if ($args{package}) {
+        $role = $parameterized_role_metaclass->create(
+            $args{package},
+            genitor    => $self,
+            parameters => $parameters,
+        );
+    } else {
+        $role = $parameterized_role_metaclass->create_anon_role(
+            genitor    => $self,
+            parameters => $parameters,
+        );
+    }
 
     local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
 
@@ -187,7 +196,8 @@ The arguments are those specified by the consumer as parameter values.
 Returns a new instance of
 L<MooseX::Role::Parameterized::Meta::Role::Parameterized> based on the
 arguments. The arguments are a hash reference of C<parameters> and, if
-available, a C<consumer> metaobject.
+available, a C<consumer> metaobject.  A C<package> argument may be given to use
+a specific package name instead of autogenerating one.
 
 =head2 apply
 
@@ -7,7 +7,7 @@ use Scalar::Util 'blessed';
 
 use MooseX::Role::Parameterized::Meta::Role::Parameterizable;
 
-our $VERSION = '0.20';
+our $VERSION = '0.21';
 our $CURRENT_METACLASS;
 
 Moose::Exporter->setup_import_methods(
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 8;
+use Test::More 0.96 tests => 3;
 use Test::Exception;
 
 my ($parameters, %args);
@@ -32,22 +32,54 @@ do {
 
 ok(MyPerson->meta->has_role_generator, "MyPerson has a role generator");
 
-my $role = MyPerson->meta->generate_role(
-    parameters => {
-        default_age => 7,
-    },
-);
+subtest "generation of an anonymous role" => sub {
+    plan tests => 8;
+    my $role = MyPerson->meta->generate_role(
+        parameters => {
+            default_age => 7,
+        },
+    );
+
+    isa_ok($role, 'Moose::Meta::Role', 'generate_role created a role');
 
-isa_ok($role, 'Moose::Meta::Role', 'generate_role created a role');
+    like($role->name, qr{ANON}, '...with an anonymous name');
 
-is($role->parameters, $parameters, 'the generated role knows its parameters');
+    is($role->parameters, $parameters, 'the generated role knows its parameters');
 
-is($parameters->default_age, 7);
-is($args{operating_on}, $role, "we pass in the role metaclass that we're operating on");
+    is($parameters->default_age, 7);
+    is($args{operating_on}, $role, "we pass in the role metaclass that we're operating on");
 
-my $age_attr = $role->get_attribute('age');
-is($age_attr->{default}, 7, "role's age attribute has the right default");
+    my $age_attr = $role->get_attribute('age');
+    is($age_attr->{default}, 7, "role's age attribute has the right default");
+
+    my $birthday_method = $role->get_method('birthday');
+    is($birthday_method->name, 'birthday', "method name");
+    is($birthday_method->package_name, $role->name, "package name");
+};
+
+subtest "generating a role with a provided name" => sub {
+    plan tests => 8;
+
+    my $role = MyPerson->meta->generate_role(
+        package    => 'RJBS::Was::Here',
+        parameters => {
+            default_age => 10,
+        },
+    );
 
-my $birthday_method = $role->get_method('birthday');
-is($birthday_method->name, 'birthday', "method name");
-is($birthday_method->package_name, $role->name, "package name");
+    isa_ok($role, 'Moose::Meta::Role', 'generate_role created a role');
+
+    is($role->name, 'RJBS::Was::Here', '...with the name we expected');
+
+    is($role->parameters, $parameters, 'the generated role knows its parameters');
+
+    is($parameters->default_age, 10);
+    is($args{operating_on}, $role, "we pass in the role metaclass that we're operating on");
+
+    my $age_attr = $role->get_attribute('age');
+    is($age_attr->{default}, 10, "role's age attribute has the right default");
+
+    my $birthday_method = $role->get_method('birthday');
+    is($birthday_method->name, 'birthday', "method name");
+    is($birthday_method->package_name, $role->name, "package name");
+};